﻿Imports System.IO
Imports System.Xml
''' <summary>
''' 输出sld
''' </summary>
Public Class OutPutSld
    Private m_objDoc As XmlDocument = Nothing
    Private m_objRoot As XmlElement
    Private m_cXMLFilename As String = ""
    Private namespaces As New Dictionary(Of String, String)
    Private _sePrefix As String = "se:"
    Private _ogcPrefix As String = "ogc:"
    Private _version As String = "1.1.0"
    Private mPreserveWhitespace As Boolean = False
    Sub New(filename As String, PreserveWhitespace As Boolean)
        m_cXMLFilename = filename
        mPreserveWhitespace = PreserveWhitespace
        'm_objDoc = New XmlDocument
        'm_objRoot = m_objDoc.DocumentElement
        'm_objDoc.Load(filename)
        'm_objDoc.LoadXml("<?xml version=""1.0"" encoding=""UTF-8""?>")
        namespaces.Add("", "http://www.opengis.net/sld")
        namespaces.Add("ogc", "http://www.opengis.net/ogc")
        namespaces.Add("xlink", "http://www.w3.org/1999/xlink")
        namespaces.Add("se", "http://www.opengis.net/se")
        namespaces.Add("schemaLocation", "http://www.opengis.net/sld http://schemas.opengis.net/sld/1.1.0/StyledLayerDescriptor.xsd")
        namespaces.Add("xsi", "http://www.w3.org/2001/XMLSchema-instance")
        'addNameSpace(m_objRoot, "se", "http://www.opengis.net/se")
        'addNameSpace(m_objRoot, "", "")
        'addNameSpace(m_objRoot, "", "")
        'addNameSpace(m_objRoot, "", "")
        'addNameSpace(m_objRoot, "", "")
        CreateNewFile(True)
    End Sub
    Public Function writeSldLayer(sldLayer As SLDLayer) As Boolean
        Dim lyrEle As XmlElement = CreateElement("NamedLayer")
        appendSubAttributes(lyrEle, _sePrefix & "Name", sldLayer.layerName)
        Dim userStyleEle As XmlElement = CreateElement("UserStyle")
        'appendSubAttributes(lyrEle, _sePrefix & "Description", sldLayer.description)
        Dim styles As List(Of SLDStyle) = sldLayer.styles
        For Each style In styles
            Dim styleEle As XmlElement = writeStylesOfLayer(style)
            userStyleEle.AppendChild(styleEle)
        Next
        lyrEle.AppendChild(userStyleEle)
        m_objRoot.AppendChild(lyrEle)
        Return True
    End Function
    Private Function writeStylesOfLayer(style As SLDStyle) As XmlElement
        Dim featuretypeStyleEle As XmlElement = CreateElement(_sePrefix & "FeatureTypeStyle")
        appendSubAttributes(featuretypeStyleEle, _sePrefix & "Name", style.styleName)
        Dim rules As List(Of SLDRule) = style.rules
        For Each rule In rules
            Dim ruleEle As XmlElement = getRule(rule)
            featuretypeStyleEle.AppendChild(ruleEle)
        Next
        Return featuretypeStyleEle
    End Function
    Private Function getRule(rule As SLDRule) As XmlElement
        Dim ruleEle As XmlElement = CreateElement(_sePrefix & "Rule")
        appendSubAttributes(ruleEle, _sePrefix & "Name", rule.ruleName)
        'appendSubAttributes(ruleEle, _sePrefix & "Title", rule.title)
        'appendSubAttributes(ruleEle, _sePrefix & "Abstract", rule.description)
        setRuleFilter(ruleEle, rule.sql)
        Dim symbols As List(Of Object) = rule.mSymbolizerOrParas
        For Each symbolizer In symbols
            If TypeOf symbolizer Is SLDSymbolizer Then
                Dim symEles As List(Of XmlElement) = getSymbolizer(rule, symbolizer)
                For Each symEle In symEles
                    ruleEle.AppendChild(symEle)
                Next
            ElseIf TypeOf symbolizer Is SLdParameter Then
                setSymbolAttribute(ruleEle, symbolizer)
            End If
        Next
        Return ruleEle
    End Function
    Private Sub setRuleFilter(ruleEle As XmlElement,
                                   filter As String)
        If (filter Is Nothing OrElse ruleEle Is Nothing) Then
            Return
        End If
        If String.IsNullOrWhiteSpace(filter) Then
            Return
        End If
        Dim filterXmlEle As XmlElement = CreateElement("ogc:Filter")
        Dim parseCQL As New CQLParser
        Dim cqlFilter As CQLComparison = parseCQL.Parse(filter)
        Dim sqlEle As XmlElement = writeSQL(cqlFilter)
        filterXmlEle.AppendChild(sqlEle)
        'Dim count As Integer = filter.FieldNameList.Count
        'For i As Integer = 0 To count - 1
        '    Dim operEle As XmlElement = CreateElement("ogc:" & filter.FieldOper.ToString)
        '    Dim propertyEle As XmlElement = CreateElement("ogc:PropertyName")
        '    propertyEle.InnerText = filter.FieldNameList.Item(i)
        '    Dim propertyValueEle As XmlElement = CreateElement("ogc:Literal")
        '    propertyValueEle.InnerText = filter.FieldValueList.Item(i)
        '    operEle.AppendChild(propertyEle)
        '    operEle.AppendChild(propertyValueEle)
        '    filterXmlEle.AppendChild(operEle)
        'Next
        ruleEle.AppendChild(filterXmlEle)
    End Sub
    Private Function writeSQL(aoLast As CQLComparison) As XmlElement
        Dim sqlEle As XmlElement = Nothing
        writeSQLSub(sqlEle, aoLast)
        Return sqlEle
    End Function
    Private Sub writeSQLSub(ByRef parentEle As XmlElement,
                              aoLast As CQLComparison)
        '  Dim node As XmlElement = CreateElement(aoLast.Oper)
        If parentEle Is Nothing Then
            parentEle = CreateElement(_ogcPrefix & aoLast.Oper)
        End If
        Dim aoParts As List(Of Object) = aoLast.OperParts
        For Each ao In aoParts
            If TypeOf ao Is CQLComparison Then
                Dim partEle As XmlElement = CreateElement(_ogcPrefix & CType(ao, CQLComparison).Oper)
                writeSQLSub(partEle, ao)
                parentEle.AppendChild(partEle)
            Else
                parentEle.InnerText = ao.ToString
            End If
        Next

    End Sub
    Private Function getSymbolizer(rule As SLDRule,
                                   symbolizer As SLDSymbolizer) As List(Of XmlElement)
        Dim symbolizerXmlEles As New List(Of XmlElement)
        Dim stype As String = rule.symbolType.ToString
        Dim symbolLayers As List(Of SLDSymbolLayer) = symbolizer.layers
        For Each symbolLyr In symbolLayers
            Dim symboltype As String = stype
            Dim symbols As List(Of Object) = symbolLyr.SymbolsOrParas
            '查找是否存在PerpendicularOffset，如果存在，则用polyline
            Dim isHasOffset As Boolean = False
            Dim isHasAllStroke As Boolean = True
            For Each symbol In symbols
                If TypeOf symbol Is SLdParameter Then
                    Dim p As SLdParameter = symbol
                    If p.paraname.ToLower = "PerpendicularOffset".ToLower Then
                        isHasOffset = True
                    End If
                ElseIf TypeOf symbol Is SLDSymbol Then
                    Dim p As SLDSymbol = symbol
                    If p.symbolType.ToLower <> "Stroke".ToLower Then
                        isHasAllStroke = False
                    End If
                Else
                    isHasAllStroke = False
                End If
            Next
            If isHasOffset And isHasAllStroke Then
                symboltype = "LineSymbolizer"
            End If
            Dim symbolizerXmlEle As XmlElement = CreateElement(_sePrefix & symboltype)
            Dim hasSymbol As Boolean = False
            For Each symbol In symbols
                If TypeOf symbol Is SLDSymbol Then
                    If symbol.symbolType.ToLower = "fill" Then
                        Dim lstNewSymbol As List(Of SLDSymbol) = resetFillGraphicFillSym(symbol)
                        For Each newsymbol In lstNewSymbol
                            Dim prefix As String = _sePrefix
                            If newsymbol.isOGCPrefix Then
                                prefix = _ogcPrefix
                            End If
                            Dim symbolizerNewXmlEle As XmlElement = CreateElement(prefix & symboltype)
                            Dim symbolXmlNewElement As XmlElement = getSymbolElement(newsymbol)
                            symbolizerNewXmlEle.AppendChild(symbolXmlNewElement)
                            For Each symbol111 In symbols
                                If TypeOf symbol111 Is SLdParameter Then
                                    setSymbolAttribute(symbolizerNewXmlEle, symbol111)
                                End If
                            Next
                            symbolizerXmlEles.Add(symbolizerNewXmlEle)
                        Next
                    Else
                        Dim symbolXmlElement As XmlElement = getSymbolElement(symbol)
                        symbolizerXmlEle.AppendChild(symbolXmlElement)
                        hasSymbol = True
                    End If
                ElseIf TypeOf symbol Is SLdParameter Then
                    setSymbolAttribute(symbolizerXmlEle, symbol)
                End If
            Next
            If symbolizerXmlEle.ChildNodes.Count > 0 AndAlso hasSymbol Then
                symbolizerXmlEles.Add(symbolizerXmlEle)
            End If
        Next
        Return symbolizerXmlEles
    End Function
    Private Function resetFillGraphicFillSym(symbol As SLDSymbol) As List(Of SLDSymbol)
        Dim res As New List(Of SLDSymbol)
        Dim paras As List(Of Object) = symbol.sldParamOrSymbols
        '##############fill-graphicfill-grapch
        If symbol.symbolType.ToLower <> "fill" Then
            res.Add(symbol)
            Return res
        End If
        Dim removeIndex As New List(Of Integer)
        For i As Integer = 0 To paras.Count - 1
            Dim para As Object = paras.Item(i)
            If Not TypeOf para Is SLDSymbol Then
                Continue For
            End If
            Dim symPara As SLDSymbol = para
            If symPara.symbolType.ToLower <> "graphicfill" Then
                Continue For
            End If
            removeIndex.Add(i)
            Dim childParas As List(Of Object) = symPara.sldParamOrSymbols
            If childParas.Count > 0 Then
                For Each childpara In childParas
                    Dim newSldSymbol As New SLDSymbol(symbol.symbolType, symbol.isOGCPrefix)
                    Dim newSldSymbolGF As New SLDSymbol(symPara.symbolType, symbol.isOGCPrefix)
                    newSldSymbolGF.sldParamOrSymbols.Add(childpara)
                    newSldSymbol.sldParamOrSymbols.Add(newSldSymbolGF)
                    Res.Add(newSldSymbol)
                Next
            End If
        Next
        removeIndex.Reverse()
        For Each i In removeIndex
            paras.RemoveAt(i)
        Next
        If symbol.sldParamOrSymbols.Count > 0 Then
            res.Add(symbol)
        End If
        Return res
    End Function
    Private Function getSymbolElement(symbol As SLDSymbol) As XmlElement
        Dim prefix As String = _sePrefix
        If symbol.isOGCPrefix Then
            prefix = _ogcPrefix
        End If
        Dim symbolXmlElement As XmlElement = CreateElement(prefix & symbol.symbolType)
        Dim paras As List(Of Object) = symbol.sldParamOrSymbols
        'para
        For Each para In paras
            If TypeOf para Is SLdParameter Then
                setSymbolAttribute(symbolXmlElement, para)
            ElseIf TypeOf para Is SLDSymbol Then
                Dim subsymEle As XmlElement = getSymbolElement(para)
                symbolXmlElement.AppendChild(subsymEle)
            End If
        Next
        If symbol.OtherPropertys.Count > 0 Then
            For Each kvp In symbol.OtherPropertys
                setNodeAttribute(symbolXmlElement, kvp.Key, kvp.Value)
            Next
        End If
        Return symbolXmlElement
    End Function
    Private Function setSymbolAttribute(symbolXml As XmlElement,
                                        para As SLdParameter)

        Dim paraEle As XmlElement = Nothing
        Dim propertname As String = para.propertyName
        If para.mCdata Then
            '直接创建cdata
            Dim c As XmlNode = CreateCData(para.value)
            symbolXml.AppendChild(c)
            Return True
        End If
        Dim prefix As String = _sePrefix
        If para.isOGCPrefix Then
            prefix = _ogcPrefix
        End If
        If para.isStandAlone Then
            If String.IsNullOrWhiteSpace(propertname) Then
                paraEle = CreateElement(prefix & para.paraname)
                paraEle.InnerText = para.value
            Else
                paraEle = CreateElement(prefix & propertname)
                setNodeAttribute(paraEle, prefix & para.paraname, para.value)
            End If
        Else
            If (String.IsNullOrWhiteSpace(propertname)) Then
                propertname = "SvgParameter"
            End If
            paraEle = CreateElement(prefix & propertname)
            setNodeAttribute(paraEle, "name", para.paraname)
            paraEle.InnerText = para.value
        End If
        If para.OtherPropertys.Count > 0 Then
            For Each kvp In para.OtherPropertys
                setNodeAttribute(paraEle, kvp.Key, kvp.Value)
            Next
        End If
        symbolXml.AppendChild(paraEle)
        Return True
    End Function
    Private Function appendSubAttributes(symbolXml As XmlElement, paraName As String, paraValue As String) As Boolean
        If symbolXml Is Nothing OrElse
            String.IsNullOrWhiteSpace(paraName) OrElse
            String.IsNullOrWhiteSpace(paraValue) Then
            Return False
        End If
        Dim lyrnameele As XmlElement = CreateElement(paraName)
        lyrnameele.InnerText = paraValue
        symbolXml.AppendChild(lyrnameele)
        Return True
    End Function
    Public Function SaveDoc() As Boolean
        Try
            'm_objDoc.Save(m_cXMLFilename)
            Dim encoding As New System.Text.UTF8Encoding(False)
            Dim sw As StreamWriter = New StreamWriter(m_cXMLFilename, False, encoding)
            m_objDoc.Save(sw)
            sw.WriteLine()
            sw.Close()
            Return True
        Catch ex As Exception
            'ErrorMsg("Fehler beim speichern der Datei", ex.Message, ex.StackTrace, "SaveDoc")
        End Try
        Return False
    End Function
#Region "创建xmlfile"
    Public Function CreateNewFile(ByVal OverWrite As Boolean) As Boolean
        Dim objDeclare As XmlDeclaration
        Dim cNamePre As String
        Try
            If File.Exists(m_cXMLFilename) = True Then
                If OverWrite = False Then
                    Throw New Exception("createnewfile 失败！")
                    Return False
                End If
                File.Delete(m_cXMLFilename)
            End If
            cNamePre = "StyledLayerDescriptor"
            m_objDoc = New XmlDocument()
            '不要空格，否则Label连接有问题
            m_objDoc.PreserveWhitespace = mPreserveWhitespace
            m_objRoot = CreateElement(cNamePre)
            m_objDoc.AppendChild(m_objRoot)
            For Each kvp In namespaces
                addNameSpace(m_objRoot, kvp.Key, kvp.Value)
            Next
            setNodeAttribute(m_objRoot, "version", _version)
            'Hier werden die Namespaces geschrieben
            objDeclare = m_objDoc.CreateXmlDeclaration("1.0", "GB2312", "yes") 'Version muss z.Zt. 1.0 sein!
            m_objDoc.InsertBefore(objDeclare, m_objRoot)
            Return True
        Catch ex As Exception
            ShowMessage("出错 (" & ex.Message.ToString & ")", ex.Message, ex.StackTrace, "CreateNewFile")
            Return Nothing
        End Try
    End Function
    Public Function setNodeAttribute(node As XmlNode,
                                    ByVal AttributeName As String, ByVal value As String) As Boolean
        Dim objXmlAttribute As XmlAttribute
        Try
            'Dim pos As Integer = AttributeName.IndexOf(":")
            'Dim prefix As String = ""
            'If pos > 0 Then
            '    prefix = AttributeName.Substring(0, pos)
            '    AttributeName = AttributeName.Substring(pos + 1)
            'End If
            Dim pos As Integer = AttributeName.IndexOf(":")
            Dim prefix As String = ""
            While (pos > 0)
                prefix = AttributeName.Substring(0, pos)
                AttributeName = AttributeName.Substring(pos + 1)
                pos = AttributeName.IndexOf(":")
            End While
            If String.IsNullOrWhiteSpace(prefix) Then
                objXmlAttribute = m_objDoc.CreateAttribute(AttributeName)
            Else
                objXmlAttribute = m_objDoc.CreateAttribute(prefix, AttributeName, getNameSpaceURL(prefix))
            End If

            objXmlAttribute.Value = value
            node.Attributes.Append(objXmlAttribute)
            Return True
        Catch ex As Exception
            ShowMessage("错误", ex.Message, ex.StackTrace, "CreateAttribute")
            Return False
        End Try
    End Function
    Public Function addNameSpace(node As XmlNode,
                                    ByVal name As String, ByVal url As String) As Boolean
        Dim objXmlAttribute As XmlAttribute
        Try
            Dim sname As String = name
            If (String.IsNullOrWhiteSpace(name)) Then
                sname = "xmlns"
            Else
                sname = "xmlns:" + name
            End If
            objXmlAttribute = m_objDoc.CreateAttribute(sname)
            objXmlAttribute.Value = url
            node.Attributes.Append(objXmlAttribute)
            Return True
        Catch ex As Exception
            ShowMessage("错误", ex.Message, ex.StackTrace, "CreateAttribute")
            Return False
        End Try
    End Function
    Public Function CreateElement(name As String) As XmlElement
        Dim pos As Integer = name.IndexOf(":")
        Dim prefix As String = ""
        While (pos > 0)
            prefix = name.Substring(0, pos)
            name = name.Substring(pos + 1)
            pos = name.IndexOf(":")
        End While
        Dim xmlEle As XmlElement = m_objDoc.CreateElement(prefix, name, getNameSpaceURL(prefix))
        Return xmlEle
    End Function
    Public Function CreateCData(cdataContent As String) As XmlNode
        Dim cdata As XmlCDataSection = m_objDoc.CreateCDataSection(cdataContent)
        Return cdata
    End Function
    Private Function getNameSpaceURL(space As String) As String
        If String.IsNullOrWhiteSpace(space) Then
            space = ""
        End If
        If namespaces.ContainsKey(space) = False Then
            Return ""
        End If
        Return namespaces.Item(space)
    End Function

#End Region
#Region "message"
    Private Sub ShowMessage(ByVal message As String, ByVal exMessage As String, ByVal stack As String, ByVal functionname As String)
        MessageBox.Show(message & "." & vbCrLf & exMessage & vbCrLf & stack, " " & functionname, MessageBoxButtons.OK, MessageBoxIcon.Error)
    End Sub
#End Region
End Class
